#! /usr/bin/perl
use strict;
use Crypt::Twofish;
use utf8;
use Time::Local;

use vars qw(@SPR $Fehler $FehlerCode);

# PDF geht nur online ...
if ($ENV{'HTTP_HOST'} ne "127.0.0.1")
{
  use HTML::Entities;
  require "PDFreactor.pm";
}


no utf8;

require "_req_ol_new.pl";
require "_req_error_ac.pl";

# login_2.pl - by Rolf Mohr (webmaster@standort-dortmund.de)

# AB NOVEMBER 2015: das Login wird optisch (CSS) umgebaut und mit dem "MitmachCode" verknüpft (lgmc_wtl_2).pl.
# Alte Version ist "login.pl" (nur noch hier: offline)


# WICHTIG: diese Version von "login_2.pl" nur im ROOT CGI-BIN ablegen,
# da Pfade und teilweise Funktionen anders sind als in den Projektordnern!!!!

# hier wird als 1. Zeichen der VK immer (!) ein "p" vergeben!
# die Sprache wird über den Parameter "L" geregelt!


# *****************************************************************************************************
# VARIABLE UND KONSTANTE
# *****************************************************************************************************

my $MailProg = '/usr/sbin/sendmail';
my $TFK = "4JuGsr52TrsHcVs9zTf36Gf7zRq4Gs7b";

my @Eingabeliste = (); my $Eingabe = 0; my $Eintrag = 0;
my $Name = 0; my $Wert = 0; my %Aufruf = ();

my $Do_The_PDF_Print = 1; # 1 = PDF PRINTER NUTZEN (wird weiter unten durch das System auf "0" gesetzt wenn offline)

# *****************************************************************************************************

# Formulardaten (GET oder POST) einlesen und umformen ---------------------------------
if ($ENV{REQUEST_METHOD} eq "GET")
{
 @Eingabeliste = split(/&/, $ENV{'QUERY_STRING'});
}
else
{
 read(STDIN, $Eingabe, $ENV{'CONTENT_LENGTH'});
 @Eingabeliste = split(/[&;]/, $Eingabe);
}
foreach $Eintrag (@Eingabeliste)
{
 $Eintrag =~ s/\+/ /go;
 ($Name, $Wert) = split(/=/, $Eintrag);
 $Name =~ s/\%(..)/pack("c", hex($1))/ge;
 $Wert =~ s/\%(..)/pack("c", hex($1))/ge;
 $Wert =~ s/[{|+*}<>#~=\[\]\t\r\"\'\n]//g;
 $Aufruf{$Name} = $Wert;
}

$Fehler = "";
$FehlerCode = 0;

my $StartPageFlag = 0; # Steuert die Texte auf der Startseite (Login) -> siehe &Start

# Sprache laden - HIER ANDERER PFAD ALS IN DEN PROJEKTORDNERN!
$Name = lc($Aufruf{'L'}); $Wert = "login/login_order_$Name.pl";
if (-e $Wert) { open (DATEI,"<$Wert"); @SPR = <DATEI>;  close (DATEI);}
else { open (DATEI,"<login/login_order_d.pl"); @SPR = <DATEI>;  close (DATEI);}
for (@SPR) {chomp $_;}


# Versuch, PDF Printer option via HOST zu steuern
if ($ENV{'HTTP_HOST'} eq "127.0.0.1") { $Do_The_PDF_Print = 0; }


if ($Aufruf{'S'} eq "A")			# Formular Start (wird eigentlich nie direkt aufgerufen)
{
 &Start;
}
elsif ($Aufruf{'S'} <= 1)		# Check
{
 &Check1;
 if ($Fehler ne "") {&Start;}
}

elsif ($Aufruf{'S'} == 10)		# Passwort vergessen 1
{
 &PW1;
}
elsif ($Aufruf{'S'} == 11)		# Passwort vergessen 2
{
 &PW2;
 if ($Fehler ne "") {&PW1;}
}

exit(0);

# *****************************************************************************************************
#        SUBROUTINEN
# *****************************************************************************************************


# Passwort vergessen 2
sub PW2
{
 my $Dummy = 0; my $DM = 0;
 my @Data1 = (); my @ET1 = (); my @MBR = (); my @DerUser = ();
 my $Test = 0; my $i = 0; my $k = 0; my $res = 0;
 my $TM = time(); my $Projektordner = ""; my @Temp1 = ();


 $Aufruf{'EM'} = lc($Aufruf{'EM'});

 # Schritt 1: zunächst die Email-Adresse in den globalen Daten abgleichen (siehe readme.txt hier im Ordner)
 $i = substr($Aufruf{'EM'}, 0, 1); # erster Buchstabe der Email bestimmt Namen der Datenbank
 $DM = "login/".$i."_logdata_163_.pl";
 open (DATEI,"<$DM"); @Data1 = <DATEI>; close (DATEI);

 $Test = 0;
 for (@Data1)
 {
  if (length($_) > 3)
  {
   $Dummy = &Hex_2_Ascii ($_);
   $k = (split("#", $Dummy))[0];
   if ($k eq $Aufruf{'EM'}) {$Projektordner = (split("#", $Dummy))[1];  $Test = 1; last;}
  }
 }


 if (! $Test) {$Fehler = $SPR[123]; return;} # Email nicht gefunden

 # Schritt 2: Email und Passwort im Projektordner testen
 $DM = "../".$Projektordner."/cgi-bin/_system/_dt_acount_login_tp504_.pl";
 open (DATEI,"<$DM"); @Data1 = <DATEI>; close (DATEI);

 $Test = ""; my $KK = ""; my $DC_EM = "";
 my $EM_Keep = ""; my $PW_Keep = "";

 my $EM_Error = 1; my $PW_Error = 1;

 my $Cipher = Crypt::Twofish->new($TFK);

 for (@Data1)
 {
  if (length($_) > 5)
  {
   @ET1 = split("\t", $_);

   # dekodieren: E-Mail
   $KK = &Hex_2_Ascii($ET1[0]);
   $DC_EM = "";
   for ($i = 0; $i < 16; $i++)
   {
    $k = substr($KK, $i * 16, 16);
    $DC_EM .= $Cipher->decrypt($k);
   }
   $EM_Keep = (split("#", $DC_EM))[0];

   if (lc($EM_Keep) eq $Aufruf{'EM'})
   {
    $EM_Error = 0; # Email gefunden
    @DerUser = split("\t", $_); last;
   } # email gefunden
  } # length > 5
 } # for Data1

 # Testen ...
 if ($EM_Error) {$Fehler = $SPR[123]; $FehlerCode = 1; return;}

 # User gefunden - weiter gehts

 # "Vorspann" merken, damit es weiter unten etwas einfacher wird
 my $DerProjektPfad = "../".$Projektordner."/cgi-bin";

 # Zunächst alte PW Änderungen bereinigen (abgelegt in _order)
 # Aufbau: Time - Key - ....
 $DM = $DerProjektPfad."/_order/recent_pw_change.pl";
 open (DATEI,"<$DM"); @Data1 = <DATEI>; close(DATEI);
 @Temp1 = ();
 for (@Data1)
 {
  if (length($_) > 4)
  {
   @ET1 = split("\t", $_); if ($ET1[0] + 86400 > $TM) {push(@Temp1, $_);}
  }
 }
 open (DATEI,">$DM"); print DATEI @Temp1; close(DATEI);
 @Data1 = @Temp1; @Temp1 = ();


 # CID einlesen für Sprach DB
 $DM = $DerProjektPfad."/dt/$DerUser[2]/cid-$DerUser[2].pl";
 if (! -e $DM) { $Fehler = $SPR[123]; $FehlerCode = 1; return; } # Kurzschluss
 open (DATEI,"<$DM"); $Dummy = <DATEI>; $Dummy = <DATEI>; close (DATEI); # Angaben CID in 2. Zeile

 $DM = $Dummy;
 $DM =~ tr/b9ejt8zvd7gao6whq5ukn4cms3fpy2ir1lx0/0123456789abcdefghijklmnopqrstuvwxyz/;
 $DM = &Hex_2_Ascii($DM); chomp $DM;
 @MBR = split("#", $DM);

 # Key
 srand;
 my $VLG = "abcdefghjklmnpqrstuvwxyz23456789abcdefghjklmnpqrstuvwxyz23456789";
 my $PW_key = $TM;
 for ($i = 0; $i < 4; $i++) { $PW_key .= substr($VLG, int(rand 50), 1); }
 $PW_key = uc($PW_key);

 # Datensatz "PW ändern" aufbauen (Aufbau siehe readme im Folder _order) + speichern
 my $NE = "$TM\t$PW_key\t$DerUser[0]\t$DerUser[1]\t$MBR[0]\t\n";
 $DM = $DerProjektPfad."/_order/recent_pw_change.pl";
 open (DATEI,">>$DM"); print DATEI $NE; close(DATEI);

 # Link zum Bestätigen aufbauen, dafür "akt-server.pl" einlesen
 $DM = $DerProjektPfad."/akt-server.pl";
 open (DATEI,"<$DM"); $Dummy = <DATEI>; $Dummy = <DATEI>; close (DATEI); # 2. Zeile = URL
 chomp $Dummy;
 my $ConfLink = $Dummy."p.php?I=$PW_key"; # "p.php" = Umleitung für Passwort vergessen

 # Mail an User senden, dafür Sprache laden
 my $Language = $MBR[0];
 my $Vname = $MBR[1];
 my $Nname = $MBR[2];
 my $ANR_4_Mail = $MBR[18]; # NEU AB 11.08.2012 - die Grußformel (Sehr geehrte) kommt nun aus der CID

 @MBR = ();
 $Dummy =  $DerProjektPfad."/dt/_lang/mail-text-$Language.pl";
 if (-e $Dummy) { open (DATEI,"<$Dummy"); @MBR = <DATEI>;  close (DATEI);}
 else
 {
  $Dummy =  $DerProjektPfad."/dt/_lang/mail-text-d.pl";
  open (DATEI,"<$Dummy"); @MBR = <DATEI>;  close (DATEI);
 }
 for (@MBR) {chomp $_;}

 open(MAIL,"|$MailProg -t -f$MBR[3]");
 print MAIL "To: $Aufruf{'EM'}\n";
 print MAIL "From: $MBR[3]\n"; # Immer Absender der Systemnachrichten
 print MAIL "Subject: $MBR[82]\n"; # PW vergessen
 print MAIL "Content-Type: text/plain; charset=utf-8\n\n";

 # NEU AB 11.08.2012 - die Grußformel (Sehr geehrte) kommt nun aus der CID
 # da zb bei franz. keine Formel, hier nun testen
 if (length($ANR_4_Mail) > 1) { print MAIL "$ANR_4_Mail $Vname $Nname$MBR[36]\n\n";} # sehr geehrter ...
 else { print MAIL "$Vname $Nname$MBR[36]\n\n";} # sehr geehrter ... (ohne Grußformel)
 print MAIL "$MBR[84]\n\n"; # bitte auf folgenden Link klicken
 print MAIL "$ConfLink\n\n"; # Link

 print MAIL "$MBR[157]\n"; # freundliche Grüße
 print MAIL "$MBR[158]\n"; # Team schuldialog

 close (MAIL);


 # normalen Header für Login aufbauen (neu ab Nov 2015)
 &NOV15_Build_Header;

 # 4er Navi aufbauen, "4" = kein Icon aktiv (neu ab Nov 2015)
 &NOV15_Build_Top(4);

 # ab hier Login Bereich (umgebaut)

 print "<div class='login-content'>\n";

 print "<h2>$SPR[125]</h2>\n\n"; # "Bitte öffnen Sie Ihr Postfach"

 print "<p class='wtg-header'>\n";
 $DM = $SPR[127]." $Aufruf{'EM'} ".$SPR[128];
 print "$DM\n"; # Sie erhalten in wenigen Minuten ....
 print "</p>\n\n";

 # link zum login - soll nicht angezeigt werden
 # print "<a class='rechts-weiterbutton-breit-a' href='login_2.pl?L=$Aufruf{'L'}&S=A'>$SPR[136]</a>\n\n";

 print "</div>\n\n"; # login-content


 # neuer Abbinder (NOV 2015)
 print "<div class='footer-home'>\n";
 print "<a href='http://www.worktogether.net/living.html' target='_blank'>powered by worktogether.net</a>\n";
 print "</div>\n\n";


 print "</div>\n";
 print "</div>\n";
 print "</div>\n";

 print "</body>\n";

 print "</html>\n";

} # PW2



# Passwort vergessen 1
sub PW1
{
 my $Dummy = 0; my $DM = 0;
 my @Data1 = (); my @ET1 = ();


 # normalen Header für Login aufbauen (neu ab Nov 2015)
 &NOV15_Build_Header;

 # 4er Navi aufbauen, ACCOUNT LOGIN aktiv (neu ab Nov 2015)
 &NOV15_Build_Top(1);

 # ab hier Login Bereich (umgebaut)

 print "<div class='login-content'>\n";

 print "<h2>$SPR[117]</h2>\n\n"; # "Passwort ändern"

 if ($Fehler ne "")
 {
  print "<p class='scl_errors head_login'>\n";
  print "$Fehler\n";
  print "</p>\n\n";
 }
 else
 {

  print "<p class='wtg-header'>\n";
  print "$SPR[119]\n"; # Bitte geben Sie Ihre E-Mail und Ihr Passwort ein.
  print "</p>\n\n";
 }

 print "<form action='login_2.pl' method='post'>\n";
 print "<input type='hidden' name='S' value='11'>\n";
 print "<input type='hidden' name='L' value='$Aufruf{'L'}'>\n";

 if ($Fehler eq "")
 {
  print "<input type='text' name='EM' value='$SPR[121]' onFocus=\"if(this.value=='$SPR[121]') this.value=''\">\n\n";
 }
 else
 {
  print "<input type='text' name='EM' value='$Aufruf{'EM'}'>\n\n";
 }

 print "<input type='submit' class='scl_but_weiter' value=''/>\n";
 print "</form>\n\n";

 print "</div>\n\n"; # login-content


 # neuer Abbinder (NOV 2015)
 print "<div class='footer-home'>\n";
 print "<a href='http://www.worktogether.net/living.html' target='_blank'>powered by worktogether.net</a>\n";
 print "</div>\n\n";

 print "</div>\n";
 print "</div>\n";
 print "</div>\n";

 print "</body>\n";

 print "</html>\n";

} # PW1


# Check: E-Mail und Passwort testen
# dies ist das Startscript! Email und Passwort kommen aus einem statischen FORMular
sub Check1
{
 my $Dummy = 0; my $DM = 0;
 my @Data1 = (); my @ET1 = (); my @MBR = (); my @DerUser = ();
 my $Test = 0; my $i = 0; my $k = 0; my $res = 0;
 my $TM = time(); my $Projektordner = "";

 $Aufruf{'EM'} = lc($Aufruf{'EM'});

 # Schritt 1: zunächst die Email-Adresse in den globalen Daten abgleichen (siehe readme.txt im Ordner "login")
 $i = substr($Aufruf{'EM'}, 0, 1); # erster Buchstabe der Email bestimmt Namen der Datenbank
 $DM = "login/".$i."_logdata_163_.pl";
 open (DATEI,"<$DM"); @Data1 = <DATEI>; close (DATEI);

 $Test = 0;
 for (@Data1)
 {
  if (length($_) > 3)
  {
   $Dummy = &Hex_2_Ascii ($_);
   $k = (split("#", $Dummy))[0];
   if ($k eq $Aufruf{'EM'}) {$Projektordner = (split("#", $Dummy))[1];  $Test = 1; last;}
  }
 }

 if (! $Test) {$Fehler = $SPR[98]; return;} # Email nicht gefunden

 # Schritt 2: Email und Passwort im Projektordner testen
 $DM = "../".$Projektordner."/cgi-bin/_system/_dt_acount_login_tp504_.pl";

 open (DATEI,"<$DM"); @Data1 = <DATEI>; close (DATEI);

 $Test = ""; my $KK = ""; my $DC_EM = "";
 my $EM_Keep = ""; my $PW_Keep = "";

 my $EM_Error = 1; my $PW_Error = 1;

 my $Cipher = Crypt::Twofish->new($TFK);

 for (@Data1)
 {
  if (length($_) > 5)
  {
   @ET1 = split("\t", $_);

   # dekodieren: E-Mail
   $KK = &Hex_2_Ascii($ET1[0]);
   $DC_EM = "";
   for ($i = 0; $i < 16; $i++)
   {
    $k = substr($KK, $i * 16, 16);
    $DC_EM .= $Cipher->decrypt($k);
   }
   $EM_Keep = (split("#", $DC_EM))[0];

   if (lc($EM_Keep) eq $Aufruf{'EM'})
   {
    $EM_Error = 0; # Email schon einmal gefunden

    # dekodieren: Passwort
    $KK = &Hex_2_Ascii($ET1[1]);
    $DC_EM = "";
    for ($i = 0; $i < 16; $i++)
    {
     $k = substr($KK, $i * 16, 16);
     $DC_EM .= $Cipher->decrypt($k);
    }
    $PW_Keep = (split("#", $DC_EM))[0];

    if ($PW_Keep eq $Aufruf{'PW'})
    {
     $PW_Error = 0;
     @DerUser = split("\t", $_);
     last;
    }
   } # email gefunden
  } # length > 5
 } # for Data1

 # Testen ...
 if ($EM_Error) {$Fehler = $SPR[98]; return;}
 if ($PW_Error) {$Fehler = $SPR[100]; return;}

 # "Vorspann" merken, damit es weiter unten etwas einfacher wird
 my $DerProjektPfad = "../".$Projektordner."/cgi-bin";

 # User gefunden: CID einlesen für Sprach DB
 $DM = $DerProjektPfad."/dt/$DerUser[2]/cid-$DerUser[2].pl";
 if (! -e $DM) { $Fehler = $SPR[98]; $FehlerCode = 1; return; } # Kurzschluss
 open (DATEI,"<$DM"); $Dummy = <DATEI>; $Dummy = <DATEI>; close (DATEI); # Angaben CID in 2. Zeile

 $DM = $Dummy;
 $DM =~ tr/b9ejt8zvd7gao6whq5ukn4cms3fpy2ir1lx0/0123456789abcdefghijklmnopqrstuvwxyz/;
 $DM = &Hex_2_Ascii($DM); chomp $DM;
 @MBR = split("#", $DM);

 # alte Logins löschen
 $DM = $DerProjektPfad."/_tmp";
 $Dummy = opendir(VERZ, "$DM"); @Data1 = readdir(VERZ); closedir VERZ;

 my $D1 = 0; my $D2 = localtime($TM);
 for (@Data1)
 {
  if (length($_) > 18)
  {
   $Dummy = "_tmp/".$_;
   @ET1 = stat($Dummy);
   if ($ET1[9] + 10800 < $TM) {$DM = unlink($Dummy);} # 180 Minuten
  }
 }
 @Data1 = (); @ET1 = ();

 # für Login-Datei Login (2/3) und CID verbinden
 my $LogKomp = "$DerUser[2]\t$DerUser[3]\t";
 for (@MBR) {$LogKomp .= "$_\t";} $LogKomp .= "\n";

 # VK
 srand;
 my $VLG = "abcdefghjklmnpqrstuvwxyz23456789abcdefghjklmnpqrstuvwxyz23456789";
 # login für PC, hier also VK mit "p" beginnen

 # NEU 27.08.2012: das Login für PC und Handy ist identisch. Keine Unterscheidung mehr nötig!
 # "p" aber ruhig weiter benutzen ....
 my $VK = "p".$TM."_";
 for ($i = 0; $i < 22; $i++) { $VK .= substr($VLG, int(rand 50), 1); }
 $VK = lc($VK);

 # Datei mit VK anlegen
 $Dummy = $DerProjektPfad."/_tmp/$VK".".pl";
 open (DATEI,">$Dummy"); print DATEI $LogKomp; close (DATEI);

 # normalen Header für Login aufbauen (neu ab Nov 2015)
 &NOV15_Build_Header;

 # 4er Navi aufbauen, ACCOUNT LOGIN aktiv (neu ab Nov 2015)
 &NOV15_Build_Top(1);


 # ab hier Login Bereich (umgebaut)

 print "<div class='login-content'>\n";

# print "<h2>$SPR[104]</h2>\n"; # PRÜFUNG DER ZUGANGSDATEN
# print "<p>\n";
# print "$SPR[106]\n"; #  Ihre Zugangsdaten wurden bestätigt ....
# print "</p>\n\n";

 # zum Account - hier zwischen Schul- und Dialog-Account unterscheiden.
 # auf ofs [4] auf "DA" (Dialog-Account) testen
 if ($DerUser[4] eq "DA")
 {
  # Dialog-Account  $DerProjektPfad
  $Dummy = $DerProjektPfad."/dt/ac_main.pl?VK=$VK";
  print "<a href='$Dummy' class='rechts-weiterbutton-breit-a'>$SPR[108]</a>\n";
 }
 else
 {
  # Schul-Account
  $Dummy = $DerProjektPfad."/dt/_acs_main.pl?VK=$VK";
  print "<a href='$Dummy' class='rechts-weiterbutton-breit-a'>$SPR[108]</a>\n";
 }

 print "</div>\n\n"; # login-content

 # neuer Abbinder (NOV 2015)
 print "<div class='footer-home'>\n";
 print "<a href='http://www.worktogether.net/living.html' target='_blank'>powered by worktogether.net</a>\n";
 print "</div>\n\n";

 print "</div>\n";
 print "</div>\n";
 print "</div>\n";

 print "</body>\n";

 print "</html>\n";

} # Check1

# Login: Start
sub Start
{
 my $Dummy = 0; my $DM = 0;
 my @Data1 = (); my @ET1 = ();

 # normalen Header für Login aufbauen (neu ab Nov 2015)
 &NOV15_Build_Header;

 # 4er Navi aufbauen, ACCOUNT LOGIN aktiv (neu ab Nov 2015)
 &NOV15_Build_Top(1);

 # ab hier Login Bereich (umgebaut)

 print "<div class='login-content'>\n";

 if ($Fehler ne "")
 {
  print "<p class='scl_errors head_login'>\n";
  print "$Fehler\n";
  print "</p>\n\n";
 }
 else
 {
  print "<p class='wtg-header'>\n";
  print "$SPR[80]\n"; # Bitte geben Sie Ihre E-Mail und Ihr Passwort ein.
  print "</p>\n\n";
 }

 print "<form action='login_2.pl' method='post'>\n";
 print "<input type='hidden' name='L' value='$Aufruf{'L'}'>\n";

 if ($Fehler eq "")
 {
  print "<input type='text' name='EM' value='$SPR[121]' onFocus=\"if(this.value=='$SPR[121]') this.value=''\">\n\n";
  print "<input type='password' name='PW' value='Xo86F' onFocus=\"if(this.value=='Xo86F') this.value=''\">\n\n";
 }
 else
 {
  print "<input type='text' name='EM' value='$Aufruf{'EM'}' />\n";
  print "<input type='password' name='PW' value='$Aufruf{'PW'}' />\n\n";
 }

 print "<input type='submit' class='scl_but_submit' value=''/>\n";

 print "</form>\n\n";


 print "<a class='scl_neues_pw' href='login_2.pl?S=10&L=$Aufruf{'L'}'>$SPR[91]</a>\n\n"; # neues PW


 print "</div>\n\n"; # login-content


 # neuer Abbinder (NOV 2015)
 print "<div class='footer-home'>\n";
 print "<a href='http://www.worktogether.net/living.html' target='_blank'>powered by worktogether.net</a>\n";
 print "</div>\n\n";


 print "</div>\n";
 print "</div>\n";
 print "</div>\n";


 print "</body>\n";

 print "</html>\n";

} # Start


sub Ascii_2_Hex ($)
{
 (my $str = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg;
 return $str;
}

sub Hex_2_Ascii ($)
{
 (my $str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;
 return $str;
}